home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / Generalized LISP / Glisp 1.2 / Source files / Plisp.glisp < prev    next >
Encoding:
Text File  |  1990-08-20  |  18.8 KB  |  666 lines  |  [TEXT/CCL ]
  1.  
  2. ~---------------------------------------------------------------------------------------~
  3. ~                Rules for Plisp (Pattern Lisp)                ~
  4. ~---------------------------------------------------------------------------------------~
  5.  
  6. -define language Plisp-
  7.  
  8.  
  9. -Lisp-
  10.  
  11. `(export '(plispProgram braceExpression definePlispFunction) :glisp)
  12.  
  13.  
  14. -Plisp-
  15.  
  16. plispProgram =
  17.     ~ a Plisp program is a sequence of Plisp functions each terminated by a semicolon
  18.  
  19.     <sourceLanguage Plisp>  [ <plispFunction>:fns  ';  <flush> ]*  ->
  20.         (<reservedWords> ::fns);
  21.  
  22.  
  23. plispFunction =
  24.     ~ a Plisp function is a name, an = sign, and a sequence of zero or more rules
  25.     ~ separated by commas.  Optionally "appearance order" and "add/remove rule(s)"
  26.     ~ may appear.
  27.  
  28.     <pFunction>:name  '=  <plispRules>:rules  ->
  29.         <definePlispFunction :name :rules nil>,
  30.  
  31.     <pFunction>:name  '\(  appearance  order  ')  '=  <plispRules>:rules  ->
  32.         <definePlispFunction :name :rules t>,
  33.  
  34.     <pFunction>:name  '\(  add  [rule | rules]  ')  '=  <plispRules>:rules  ->
  35.         (addRules (quote :name) (quote :rules) nil),
  36.  
  37.     <pFunction>:name  '\(  add  [rule | rules]  ',  appearance  order  ')  '=
  38.             <plispRules>:rules  ->
  39.         (addRules (quote :name) (quote :rules) t),
  40.  
  41.     <pFunction>:name  '\(  remove  [rule | rules]  ')  '=  <plispRules>:rules  ->
  42.         (removeRules (quote :name) (quote :rules));
  43.  
  44.  
  45. plispRules =
  46.     [<plispRule>:r / ',]*  ->  :r;
  47.  
  48.  
  49. plispRule =
  50.     <lhs>  <pattern>:p1  '-'>  <rhs>  <pattern>:p2  ->  (::p1 (rewritesTo) ::p2);
  51.  
  52.  
  53. pattern =
  54.     [<item>:i]*  ->  :i;
  55.  
  56.  
  57. item =
  58.     <aLiteral>:lit  ->                    ~ x
  59.         (literal :lit),
  60.  
  61.     ':  <pVariable>:var  ->                    ~ :x
  62.         (variable :var),
  63.  
  64.     ':':  <pVariable>:var  <pattern>:pat  ->        ~ ::x
  65.         (variable :var t :pat),
  66.  
  67.     ':':  <pVariable>:var  ')  ->                ~ ::x)
  68.         (variable :var t ((endList))),
  69.  
  70.     '.'.  <pVariable '.>:var  ->                ~ ..
  71.         (variable :var),
  72.  
  73.     '.'.'.  <pVariable '.>:var  <pattern>:pat  ->        ~ ...
  74.         (variable :var t :pat),
  75.  
  76.     '.'.'.  <pVariable '.>:var  ')  ->            ~ ...)
  77.         (variable :var t ((endList))),
  78.  
  79.     '<  <fnName>:fn  '>  ->                    ~ <foo>
  80.         (call :fn),
  81.  
  82.     '<  <fnName>:fn  <rhs>  <pattern>:pat  <phs>  '>  ->    ~ <foo :x 10 "abc">
  83.         (call :fn :pat),
  84.  
  85.     '<'<  <fnName>:fn  '>'>  ->                 ~ <<foo>>
  86.         (call :fn nil t),
  87.  
  88.     '<'<  <fnName>:fn  <rhs>  <pattern>:pat  <phs>  '>'> ->    ~ <<foo :x 10 "abc">>
  89.         (call :fn :pat t),
  90.  
  91.     '[  <pVariable '[ >:v  <pattern>:pat  ']        ~ [a]
  92.             <controlVar :v>:cvar  ->
  93.         (alternatives :cvar :pat nil),
  94.  
  95.     '[  <pVariable '[ >:v  <pattern>:pat  ']        ~ [a]*
  96.             ['*|'+]  <controlVar :v>:cvar  ->
  97.         (repeat :cvar [0|1] :pat),
  98.  
  99.     '[  <pVariable '[ >:v  <pattern>:pat  '/        ~ [a / ',]*
  100.             <pattern>:sep  ']  ['*|'+]  <controlVar :v>:cvar  ->
  101.         (repeat :cvar [0|1] :pat :sep),
  102.  
  103.     '[  <pVariable '[ >:v  <pattern>:pat  '|        ~ [a | b | c]
  104.             [<pattern>:p / '|]*  ']  <controlVar :v>:cvar  ->
  105.         (alternatives :cvar :pat ::p),
  106.  
  107.     '[  <pVariable '[ >:v  <pattern>:pat  '|        ~ [a | b | c]*
  108.             [<pattern>:p / '|]*  ']  ['*|'+]=:n  <controlVar :v>:cvar  ->
  109.         (repeat :cvar [0|1]=:n ((alternatives <pVariable '|> :pat ::p))),
  110.  
  111.     '[  <pVariable '[ >:v  <pattern>:pat  '|        ~ [a | b | c / ',]*
  112.             [<pattern>:p / '|]*  '/  <pattern>:sep  ']
  113.             ['*|'+]=:n  <controlVar :v>:cvar  ->
  114.         (repeat :cvar [0|1]=:n ((alternatives <pVariable '|> :pat ::p)) :sep),
  115.  
  116.     '\(  ->  (beginList),                    ~ ( with no preceding '
  117.  
  118.     ')   ->  (endList),                    ~ ) with no preceding '
  119.  
  120.     '{  if  <braceExpression>:e                ~ {if (> foo 10)}
  121.             [':  failMessage  <braceExpression>:msg]  '}  ->
  122.         (lisp if :e [:msg]),
  123.  
  124.     '{  do  <braceExpression>:e  '}  ->            ~ {do (setq foo 10)}
  125.         (lisp do :e),
  126.  
  127.     '{  value  <braceExpression>:e                ~ {value (append x y)}
  128.             [':  failMessage  <braceExpression>:msg]  '}  ->
  129.         (lisp value :e nil [:msg]),
  130.  
  131.     '{'{  value  <braceExpression>:e            ~ {{value (append x y)}}
  132.             [':  failMessage  <braceExpression>:msg]  '}'}  ->
  133.         (lisp value :e t [:msg]);
  134.  
  135.  
  136. aLiteral =
  137.     <identifier>:id        ->  <makeReservedWord :id>,    ~ a
  138.  
  139.     <aNumber>        ->  ,                ~ 10
  140.  
  141.     <aString>  <onRight>    ->  ,                ~ "abc" (right side only)
  142.  
  143.     ~ we can't allow strings on the left side because (case ...) can't handle them,
  144.     ~ and (literals ...) is translated to (case ...).  we need to fix this someday.
  145.  
  146.     <aString>  <onLeft>    ->
  147.         <pError "strings are not currently allowed on the left sides of rules">,
  148.  
  149.     ''            ->  ;        ~ ' <any data type>, e.g. '\(  ')  'foo
  150.  
  151.  
  152. ~---------------------------------------------------------------------------------------~
  153. ~                Miscellaneous rules                    ~
  154. ~---------------------------------------------------------------------------------------~
  155.  
  156. definePlispFunction =
  157.     ~ defines a Plisp function from scratch
  158.     ~ :name  (list of rules)  t/nil--keep in appearance order?  ->  (defpfun ...)
  159.     ~ the value is a call to the defpfun macro:
  160.     ~    (defpfun name args expanded-rules rule-tree)
  161.  
  162.     :name  :rules  :appearanceOrder
  163.         <mergeRules <reverse :rules> nil :appearanceOrder>
  164.         <expandRules :name>:def  ->  :def;
  165.  
  166.  
  167. pFunction =
  168.     ~ checks if a Plisp function is being redefined
  169.  
  170.     <identifier>:name  <checkFunction :name>  ->  :name;
  171.  
  172.  
  173. reparsePlispFunction =
  174.     ~ for use by 'reparse'
  175.  
  176.     <plispFunction>:fn  ';  ->  :fn;
  177.  
  178.  
  179. fnName =
  180.     ~ either identifiers or symbols preceded by a single quote (') may appear
  181.     ~ inside angle brackets < >: <foo x y> or <'+ x y>
  182.  
  183.     [<identifier> | '']  ->  ;
  184.  
  185.  
  186. controlVar =
  187.     ~ looks for a control variable; e.g. [a]* = :n, [a|b|c] = :alt.
  188.     ~ if controls are not given explicit names, they are matched up on the left and
  189.     ~ right sides of a rule in the order in which their "[" appear
  190.  
  191.     :n  ['= ': <pVariable>:var]  ->  [:var  <restoreName '[ :n> | :n];
  192.  
  193.  
  194. braceExpression = ;
  195.     ~ this controls what type of expression is allowed to be inside braces { }.
  196.     ~ the default is ordinary Lisp s-expressions (read with the Glisp read table).
  197.  
  198.  
  199. removeRule =
  200.     ~ removes a rule from a rule tree.
  201.     ~ this needs to return a value, because it's called from a Lisp function.
  202.     ~ :rule  :tree  ->  :newtree
  203.  
  204.     :rule  :tree  <linearMatch :rule :tree>  't  ->  nil,
  205.  
  206.     :rule  :tree  <removeRule2 :rule :tree>:newtree  ->  :newtree,
  207.  
  208.     :rule  :tree  ->
  209.         <pWarning "couldn't remove the rule
  210.     "        <ruleToString :rule> "
  211. from
  212.     "        <ruleToString :tree>>
  213.         :tree;
  214.  
  215.  
  216. removeRule2 =
  217.     ~ subroutine; fails if it can't remove the rule from the tree
  218.     ~ :rule  :tree  ->  [:newtree | <failure>]
  219.  
  220.     ((rewritesTo) ...)  ((rewritesTo) ...)  ->  nil,
  221.  
  222.     (:x ...)  (:x ...)  ->  (:x <<removeRule2 (...) (...)>>),
  223.  
  224.     ((literal :x) ::rule)  ((literals ::lits))
  225.             <assoc :x :lits `:test equalp>  (:x ::r)
  226.             [<linearMatch :rule :r> 't | <removeRule2 :rule :r>:rr]  ->
  227.         <consolidateLiterals
  228.             [ <remove (:x ::r) :lits `:test equalp>
  229.             | <substitute (:x ::rr) (:x ::r) :lits `:test equalp> ]>,
  230.  
  231.     :rule  ((branches ... :r
  232.             [<linearMatch :rule :r> 't | <removeRule2 :rule :r>:rr] ...))  ->
  233.         <consolidateBranches (... [ | :rr] ...)>;
  234.  
  235.  
  236. consolidateBranches =
  237.     ~ eliminates singleton branches
  238.  
  239.     (:rule)        ->  :rule,
  240.  
  241.     :rules        ->  ((branches ::rules));
  242.  
  243.  
  244. consolidateLiterals =
  245.     ~ eliminates singleton literals
  246.  
  247.     ((:lit ...))    ->  ((literal :lit) ...),
  248.  
  249.     :rules        ->  ((literals ::rules));
  250.  
  251.  
  252. ~---------------------------------------------------------------------------------------~
  253. ~                The rule merger                        ~
  254. ~---------------------------------------------------------------------------------------~
  255. ~
  256. ~ This merges individual rules into an optimized tree.  The tree is optimal both in
  257. ~ space and execution time.
  258.  
  259.  
  260. mergeRules (appearance order) =
  261.     ~ merges a set of rules into an optimized tree; the rules are in reverse order
  262.     ~ :rules  :tree  :appearanceOrder  ->  :newtree
  263.  
  264.     (:rule ...)  :tree  :ao  <mergeRule :rule :tree :ao :rule> 't  :newtree  ->
  265.         <mergeRules (...) :newtree :ao>,
  266.  
  267.     ~ if two rules are equally specific, they are kept in appearance order
  268.  
  269.     (:rule ...)  :tree  'nil  <before :tree :rule>  't  ->
  270.         <mergeRules (...) ((branches :tree :rule)) nil>,
  271.  
  272.     (:rule ...)  :tree  :ao  ->
  273.         <mergeRules (...) ((branches :rule :tree)) :ao>,
  274.  
  275.     'nil  :tree  :ao  ->
  276.         :tree;
  277.  
  278.  
  279. mergeRule (appearance order) =
  280.     ~ merges a rule into an existing tree of rules
  281.     ~ :rule  :tree  :appearanceOrder  :originalRule  ->  [t :newtree | nil]
  282.  
  283.     ~ If the left hand sides are identical, replace the right hand side.
  284.  
  285.     ((rewritesTo) ::newrhs)  ((rewritesTo) ::oldrhs)  :ao  :or  ->
  286.         <pWarning "existing rule being replaced with:
  287.     " <ruleToString :or>>
  288.         t  ((rewritesTo) ::newrhs),
  289.  
  290.     ~ If the first items are identical, merge the remainder of the rules.
  291.  
  292.     (:x ::rule)  (:x ::tree)  :ao  :or
  293.             <mergeRule :rule :tree :ao :or>  't  :newtree  ->
  294.         t  (:x ::newtree),
  295.  
  296.     (:x ::rule)  (:x ::tree)  :ao  :or
  297.             <mergeRule :rule :tree :ao :or>  'nil  ->
  298.         t  (:x <mergeBranches nil :ao :or :rule (:tree)>),
  299.  
  300.     ~ Merge two or more literals into a literals list.
  301.  
  302.     ((literal :x) ::rule)  ((literal :y) ::tree)  :ao  :or  ->
  303.         t  ((literals (:x ::rule) (:y ::tree))),
  304.  
  305.     ((literal :x) ::rule)  ((literals ::lits))  :ao  :or  ->
  306.         t  (<mergeLiterals :x :rule :lits :ao :or>),
  307.  
  308.     ~ Merge the rule into a branch list.
  309.  
  310.     :rule  ((branches ::b))  :ao  :or  ->
  311.         t  (<mergeBranches t :ao :or :rule :b>),
  312.  
  313.     ~ End conditions
  314.  
  315.     'nil  :tree  :ao  :or  ->
  316.         t  :tree,
  317.  
  318.     :rule  'nil  :ao  :or  ->
  319.         t  :rule,
  320.  
  321.     ~ Otherwise no merging is possible.
  322.  
  323.     :rule  :tree  :ao  :or  ->
  324.         nil;
  325.  
  326.  
  327. mergeLiterals =
  328.     ~ merges a literal into an existing set of literals
  329.     ~ :lit  :rule  :literals  :appearanceOrder  :originalRule  ->  (literals ...)
  330.     ~ :literals = ((atom item item ...) (atom item item ...) ...)
  331.  
  332.     ~ Does the literal exist in the list?
  333.  
  334.     :lit  :rule  :lits  :ao  :or
  335.             <assoc :lit :lits `:test equalp>  (:lit ::r)
  336.             <mergeRule :rule :r :ao :or>  't  :newtree  ->
  337.         {do `(rplacd (assoc #$lit #$lits :test #'equalp) #$newtree)}
  338.         (literals ::lits),
  339.  
  340.     :lit  :rule  :lits  :ao  :or
  341.             <assoc :lit :lits `:test equalp>  (:lit ::r)
  342.             <mergeRule :rule :r :ao :or>  'nil
  343.             <mergeBranches nil :ao :or :rule (:r)>  :newbranch  ->
  344.         {do `(rplacd (assoc #$lit #$lits :test #'equalp) (list #$newbranch))}
  345.         (literals ::lits),
  346.  
  347.     ~ If not, add it to the beginning of the list (location doesn't really matter).
  348.  
  349.     :lit  :rule  :lits  :ao  :or  ->
  350.         (literals (:lit ::rule) ::lits);
  351.  
  352.  
  353. mergeBranches =
  354.     ~ merges a rule into an existing branch of the tree
  355.     ~ :mergeable  :appearanceOrder  :originalRule  :rule  :branches  ->  (branches ...)
  356.     ~ :branches = (rule rule ...)
  357.  
  358.     ~ First try to merge the rule with an existing branch.
  359.  
  360.     't  'nil  :or  :rule  (... :r <mergeRule :rule :r nil :or> 't :newbranch ...)  ->
  361.         (branches ... :newbranch ...),
  362.  
  363.     ~ If we can't change the order of the rules, we can still try to merge the new
  364.     ~ rule with the first branch.
  365.  
  366.     't  't  :or  :rule  (:r ...)  <mergeRule :rule :r t :or>  't  :newbranch  ->
  367.         (branches :newbranch ...),
  368.  
  369.     ~ Otherwise find a place to insert a new branch.
  370.     ~ Put the rule before the first branch which is not more specific than it.
  371.  
  372.     :me  'nil  :or  :rule  (... :r <before :r :rule> 'nil ...)  ->
  373.         (branches ... :rule :r ...),
  374.  
  375.     :me  'nil  :or  :rule  :branches  ->
  376.         (branches ::branches :rule),
  377.  
  378.     ~ Keep in appearance order.
  379.  
  380.     :me  't  :or  :rule  :branches  ->
  381.         (branches :rule ::branches);
  382.  
  383.  
  384. before (appearance order) =
  385.     ~ rule1  rule2  ->  [t (iff rule1 is more specific than rule2) | nil]
  386.  
  387.     ~ Skip to where something's different.
  388.  
  389.     ((rewritesTo) ...)  ((rewritesTo) ...)        ->  nil,    ~ equivalent
  390.     (:x ::rule1)  (:x ::rule2)            ->  <before :rule1 :rule2>,
  391.  
  392.     ~ Longer rules come before shorter rules.
  393.  
  394.     (:x ...)  ((rewritesTo) ...)            ->  t,
  395.     ((rewritesTo) ...)  (:x ...)            ->  nil,
  396.  
  397.     ~ Two literals are equally specific.  Otherwise literals come before anything.
  398.  
  399.     ((literal :x) ...)  ((literal :y) ...)        ->  nil,
  400.     ((literal :x) ...)  ((literals ...))        ->  nil,
  401.     ((literal :x) ...)  :rule2            ->  t,
  402.  
  403.     ((literals ...))  ((literal :y) ...)        ->  nil,
  404.     ((literals ...))  ((literals ...))        ->  nil,
  405.     ((literals ...))  :rule2            ->  t,
  406.  
  407.     :rule1  ((literal :y) ...)            ->  nil,
  408.     :rule1  ((literals ...))            ->  nil,
  409.  
  410.     ~ Treat Lisp values as literals; but put them at the end to encourage factoring.
  411.  
  412.     ((lisp value ...) ...)  ((lisp value ...) ...)    ->  nil,
  413.     ((lisp value ...) ...)  ((beginList) ...)    ->  nil,
  414.     ((lisp value ...) ...)  :rule2            ->  t,
  415.  
  416.     ~ Lists are equivalent to literals; put them at the end (but in front of
  417.     ~ Lisp values) to encourage factoring.
  418.  
  419.     ((beginList) ...)  :rule2            ->  t,
  420.     ((endList) ...)  :rule2                ->  nil,
  421.         ~ rule2 must have a more detailed analysis of the list
  422.  
  423.     :rule1  ((lisp value ...) ...)            ->  nil,
  424.     :rule1  ((beginList) ...)            ->  nil,
  425.     :rule1  ((endList) ...)                ->  t,
  426.         ~ rule1 must have a more detailed analysis of the list
  427.  
  428.     ~ Function calls come before variables.
  429.  
  430.     ((call ...) ...)  ((variable ...) ...)        ->  t,
  431.     ((variable ...) ...)  ((call ...) ...)        ->  nil,
  432.  
  433.     ~ Variables that have already occurred are treated as literals,
  434.     ~    e.g. (:x <some stuff> :x ...)  comes before  (:x <same stuff> :y ...).
  435.  
  436.     ((variable :x ...) ...)  ((variable :y ...) ...)  ->  {value :x < :y},
  437.         ~ *** full literal treatment needs to be added here!
  438.  
  439.     ~ Single valued variables (:x) come before multiple valued variables (::x).
  440.  
  441.     ((variable :x) ...)  ((variable :y 't ..) ...)    ->  t,
  442.     ((variable :x 't ..) ...)  ((variable :y) ...)    ->  nil,
  443.  
  444.     ~ Check the stopper patterns of multiple variables, e.g. ::x).
  445.  
  446.     ((variable :x 't :pat1) ...)  ((variable :y 't :pat2) ...)  ->
  447.         <before (::pat1 ...) (::pat2 ...)>,
  448.  
  449.     ~ Repeats are factored based on the specificity of their patterns.
  450.  
  451.     ((repeat ...) ...)  :rule2  ->
  452.         <before  <strip ((repeat ...) ...)>  <strip :rule2>>,
  453.  
  454.     ~ Alternatives are factored based on the specificity of their patterns.
  455.  
  456.     ((alternatives ...) ...)  :rule2  ->
  457.         <before  <strip ((alternatives ...) ...)>  <strip :rule2>>,
  458.  
  459.     ~ Check the other side too.
  460.  
  461.     :rule1  ((repeat ...) ...)  ->
  462.         <before  :rule1  <strip ((repeat ...) ...)>>,
  463.     :rule1  ((alternatives ...) ...)  ->
  464.         <before  :rule1  <strip ((alternatives ...) ...)>>,
  465.  
  466.     ~ Otherwise keep rules in their order of appearance.
  467.  
  468.     :rule1  :rule2  ->  nil;
  469.  
  470.  
  471. strip =
  472.     ~ Look at the entire pattern followed by the entire separator pattern.
  473.  
  474.     ((repeat :var :min :pat [:sep]) ...)  ->
  475.         <strip (::pat [::sep] ...)>,
  476.  
  477.     ~ Just look at the FIRST alternative.  (*** Can this be right??? ***)
  478.  
  479.     ((alternatives :var :alt1 ::others) ...)  ->
  480.         <strip (::alt1 ...)>,
  481.  
  482.     :rule  ->  :rule;
  483.  
  484.  
  485. ~---------------------------------------------------------------------------------------~
  486. ~                The rule expander                    ~
  487. ~---------------------------------------------------------------------------------------~
  488. ~
  489. ~ This expands rules into ordinary Lisp code that can be compiled by the Lisp compiler.
  490.  
  491.  
  492. expandRules =
  493.     :name  :tree  ->
  494.         (defpfun :name nil
  495.             (let (!dest !variables !inRepeat)
  496.                  <lhs>
  497.                  (beginPlispFunction (quote :name))
  498.                  <<expandPattern :tree>>
  499.                  (endPlispFunction (quote :name)))
  500.             :tree);
  501.  
  502.  
  503. expandPattern =
  504.     ~ returns a linear list of Common Lisp expressions
  505.  
  506.     :pat  ->  ( [<<expandItem :pat>>]* );
  507.  
  508.  
  509. expandItem =
  510.     ~ each Plisp item expands into a list of one or more Common Lisp expressions
  511.  
  512.     (literal :lit)  <onLeft>  ->
  513.         ((or (nextIs? (quote :lit))
  514.              (failure <humanize (literal :lit)>))),
  515.  
  516.     (literal :lit)  <onRight>  ->
  517.         ((setq !dest (xCons !dest (quote :lit)))),
  518.  
  519.     (variable :var)  <onLeft>  ->
  520.         ((slVariable :var)),
  521.  
  522.     (variable :var)  <onRight>  ->
  523.         ((srVariable :var)),
  524.  
  525.     (variable :var 't 'nil)  <onLeft>  ->
  526.         ((mlVariable :var t t)),
  527.         
  528.     (variable :var 't ((endList)))  <onLeft>  ->
  529.         ((mlVariable :var t t)
  530.          <<expandPattern ((endList))>>),
  531.  
  532.     (variable :var 't :pat)  <onLeft>  ->
  533.         ((cond ((vBound? :var) (mlVariable :var nil t) <<expandPattern :pat>>)
  534.                (t (loop (setDecisionPoint)
  535.                 (cond ((empty?)
  536.                        (deleteDecisionPoint)
  537.                        (failure <humanize (variable :var t :pat)>))
  538.                       ((catch !failure <<expandPattern :pat>> nil)
  539.                        (restoreDecisionPoint))
  540.                       (t (return)))
  541.                 (deleteDecisionPoint)
  542.                 (mlVariable :var nil nil))))
  543.          (deleteDecisionPoint)),
  544.  
  545.     (variable :var 't :pat)  <onRight>  ->
  546.         ((mrVariable :var)
  547.          <<expandPattern :pat>>),
  548.  
  549.     (call :fn)  [<onLeft> | <onRight>]  ->
  550.         (([lCall | rCall] (quote :fn) nil nil)),
  551.  
  552.     (call :fn :pat)  [<onLeft> | <onRight>]  ->
  553.         (([lCall | rCall] (quote :fn)
  554.             (let ((!dest (xNew)))
  555.                  <rhs>
  556.                  <<expandPattern :pat>>
  557.                  <phs>
  558.                  (cdr !dest))
  559.             nil)),
  560.  
  561.     (call :fn 'nil 't)  [<onLeft> | <onRight>]  ->
  562.         (([lCall | rCall] (quote :fn) nil t)),
  563.  
  564.     (call :fn :pat 't)  [<onLeft> | <onRight>]  ->
  565.         (([lCall | rCall] (quote :fn)
  566.             (let ((!dest (xNew)))
  567.                  <rhs>
  568.                  <<expandPattern :pat>>
  569.                  <phs>
  570.                  (cdr !dest))
  571.             t)),
  572.  
  573.     (beginList)  <onLeft>  ->    ((lBeginList)),
  574.  
  575.     (beginList)  <onRight>  ->    ((rBeginList)),
  576.  
  577.     (endList)    <onLeft>  ->    ((lEndList)),
  578.  
  579.     (endList)    <onRight>  ->    ((rEndList)),
  580.  
  581.     (repeat :var :min :pat [:sep])  ->
  582.         ((let    ((!inRepeat t) (!repeatCount 0) (max (repeatMax :var)))
  583.             (loop (setDecisionPoint)
  584.                   (cond            ~ stop?
  585.                 ((or (repeatStop? max)
  586.                      [ (and ('> !repeatCount 1)
  587.                         (catch !failure <<expandPattern :sep>> nil)
  588.                         (restoreDecisionPoint)) ]
  589.                      (and (catch !failure <<expandPattern :pat>> nil)
  590.                       (restoreDecisionPoint)))
  591.                  (deleteDecisionPoint)
  592.                  (return)))
  593.                   (deleteDecisionPoint))
  594.             (repeatSet :var :min))),
  595.  
  596.     (alternatives :var ::pats)  <onLeft>  ->
  597.         ((let    ((altVar (and (vBound? :var)
  598.                                       (not !inRepeat)    ~ for now (fix it someday!)
  599.                                       (vEval :var nil))))
  600.             (setDecisionPoint)
  601.             {do :alt := 0}
  602.             (or [ {do :alt := :alt + 1}
  603.                   <expandAlternative :pats :var :alt> ]*
  604.                 (progn (deleteDecisionPoint)
  605.                    (failure <humanize (alternatives :var ::pats)> t)))
  606.             (deleteDecisionPoint))),
  607.  
  608.     (alternatives :var ::pats)  <onRight>  ->
  609.         ((case    (altCheck :var)
  610.             {do :alt := 0}
  611.             [ ({value :alt := :alt + 1} <<expandPattern :pats>>) ]*
  612.             (t (failure <humanize (alternatives :var ::pats)>)))),
  613.  
  614.     (lisp do :e)  ->
  615.         (:e),
  616.  
  617.     (lisp if :e [:msg])  ->
  618.         ((or :e (failure [:msg | <humanize (lisp if :e)>]))),
  619.  
  620.     (lisp value :e  ['t | 'nil]  [:msg])  <onLeft>  ->
  621.         ((or ([nextAre? | nextIs?] :e)
  622.              (failure [:msg | <humanize (lisp value :e)>]))),
  623.  
  624.     (lisp value :e  ['t | 'nil]  [:msg])  <onRight>  ->
  625.         ((setq !dest ([xAppend | xCons] !dest :e))),
  626.  
  627.     (rewritesTo)  ->
  628.         <rhs>  ((setq !dest (xNew))),
  629.  
  630.     (literals ::lits)  ->            ~ always occurs on left side
  631.         ((case (peek)
  632.               [ <lhs>  <expandLiteral :lits> ]*
  633.               (t (failure <humanize (literals ::lits)>)))),
  634.  
  635.     (branches ::pats)  ->            ~ always occurs on left side
  636.         ((setDecisionPoint)
  637.          (and [    <lhs>
  638.             (catch !failure <<expandPattern :pats>> nil)
  639.             (restoreDecisionPoint) ]*
  640.               (deleteDecisionPoint)
  641.               (failure <humanize (branches ::pats)> t))
  642.          (deleteDecisionPoint)),
  643.  
  644.     :item  ->  {do pError("unrecognized item in a pattern: ", :item)}  (nil);
  645.  
  646.  
  647. expandAlternative =
  648.     'nil  :var  :n  ->
  649.         (and (or (null altVar) ('= altVar :n))
  650.              (vSet :var :n nil)),
  651.  
  652.     :pat  :var  :n  ->
  653.         (and (or (null altVar) ('= altVar :n))
  654.              (not (and (catch !failure <<expandPattern :pat>> nil)
  655.                    (restoreDecisionPoint)))
  656.              (vSet :var :n nil));
  657.  
  658.  
  659. expandLiteral =
  660.     (['t | 'nil | otherwise] ...)  ->
  661.         (([t | nil | otherwise]) (next) <<expandPattern ..>>),
  662.  
  663.     (:lit ...)    ->  (:lit (next) <<expandPattern ..>>),
  664.  
  665.     'nil        ->  nil;
  666.